home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb1 / pro2 / qb-db3.bas < prev    next >
BASIC Source File  |  1991-04-23  |  5KB  |  154 lines
  1.  
  2. '--------------------------------------------------------------------
  3. '                Create a dBASE III File from QB45              Dapro
  4. '
  5. '                Dennis Gellert      23 April 1991
  6. '
  7. '  This QB45/QBX demo program creates a dBASE III compatible file
  8. '  called TESTMAKE.DBF. The file includes 1 Record. (Note, for a
  9. '  dBASE file, the header, etc must be structured correctly, or
  10. '  dBASE will refuse to open as a valid dBASE File).
  11. '
  12. '  To change this program to create a dBASE III file with the field
  13. '  data structure you require:
  14. '  (1) Change the Data statements at the end to reflect new structure
  15. '  (2) Change the TYPE block "FldDataSpec" to follow above.
  16. '  (3) Change the code within the area labelled: "Records Go Here".
  17. '
  18. '  To edit an existing dBASE file, read the existing Header instead
  19. '  of writing. You may then calc the offset of the Records/Fields you
  20. '  wish to Edit/Append.
  21. '---------------------------------------------------------------------
  22. CLS
  23. PRINT "Create dBASE III Data File"
  24. PRINT "--------------------------"
  25. '
  26. '--- dBaseIII file header, 32 bytes ---
  27. 'Do not change!
  28. '
  29. TYPE dBHeader
  30.    Version AS STRING * 1
  31.    Lastupdate AS STRING * 3
  32.    NumRecs AS LONG
  33.    NumbytesHeader AS INTEGER
  34.    NumBytesRec AS INTEGER
  35.    Trash AS STRING * 20
  36. END TYPE
  37.  
  38. '--- Field Descriptions ---
  39. 'Do not change!
  40. '
  41. TYPE FieldDescriptor          '32 bytes * Number of Fields (up to 128)
  42.    FName AS STRING * 11
  43.    FType AS STRING * 1
  44.    DataAddress AS STRING * 4
  45.    Length AS STRING * 1
  46.    DecimalCount AS STRING * 1
  47.    Trash AS STRING * 14
  48. END TYPE
  49.  
  50. '--- Actual data written for this file ---
  51. 'This structure should follow the data structure specified
  52. 'for the dBASE file. Edit to Suit.
  53. '
  54. TYPE FldDataSpec
  55.   DELETED AS STRING * 1
  56.   CHRISTIAN AS STRING * 15
  57.   SURNAME AS STRING * 15
  58.   AGE AS STRING * 3
  59.   DOLLARS AS STRING * 6
  60. END TYPE
  61.  
  62. '--- Creating variables for user-defined types ---
  63. DIM header AS dBHeader
  64. DIM FieldDes AS FieldDescriptor
  65. DIM FldData AS FldDataSpec
  66. '
  67. '--- This will be dBASE III File ---
  68. OPEN "TESTMAKE.DBF" FOR BINARY AS #1
  69. '
  70. '--------------- Create & Write dBASE III Header -----------------
  71. READ tfields%                  'Total Fields to process
  72. header.Version = CHR$(&H3)     'dBASE III, no memo file
  73. '
  74. MID$(header.Lastupdate, 1, 1) = CHR$(VAL(RIGHT$(DATE$, 2)))
  75. MID$(header.Lastupdate, 2, 1) = CHR$(VAL(LEFT$(DATE$, 2)))
  76. MID$(header.Lastupdate, 3, 1) = CHR$(VAL(MID$(DATE$, 4, 2)))
  77. '
  78. header.NumRecs = 0
  79. '
  80. NumFields% = tfields%
  81. '
  82. 'Number of bytes in Header = 32 start +32 for each field +1 for terminator
  83. header.NumbytesHeader = 32 + (NumFields% * 32) + 1
  84. '
  85. '--- Read through data to calc length of Record (+1 for delete flag) ---
  86. RecLength% = 1
  87. FOR fldnum% = 1 TO tfields%
  88.   READ AFName$, AFType$, AL%, ADC%
  89.   RecLength% = RecLength% + AL%
  90. NEXT fldnum%
  91. '
  92. header.NumBytesRec = RecLength%
  93. header.Trash = STRING$(20, 0)    'Unused here
  94. '
  95. PUT #1, , header    'Save the Header start
  96. '
  97. '-------------- Field Descriptions ----------------
  98. nf$ = STRING$(11, 0)
  99. '
  100. FieldDes.DataAddress = STRING$(4, 0)    'Unused in File, set in memory
  101. FieldDes.Trash = STRING$(14, 0)         'Unused here
  102. '
  103. RESTORE flddes
  104. FOR fldnum% = 1 TO tfields%
  105.   'Field Names are padded with nulls, and must be in Upper case
  106.   READ AFName$: FieldDes.FName = UCASE$(LEFT$(AFName$ + nf$, 11))
  107.   READ AFType$: FieldDes.FType = UCASE$(AFType$)
  108.   READ AL%: FieldDes.Length = CHR$(AL%)
  109.   READ ADC%: FieldDes.DecimalCount = CHR$(ADC%)
  110.   PUT #1, ((fldnum% * 32) + 1), FieldDes
  111. NEXT fldnum%
  112. '
  113. FldTerm$ = CHR$(&HD)
  114. PUT #1, , FldTerm$
  115. '------------------------------------------------
  116. '
  117. '--- Records Go Here. Edit to Suit. ---
  118. 'DO
  119.    'Include the loop if appending a number of records
  120.    FldData.DELETED = CHR$(32)      'SPACE for NOT deleted flag (* =deleted)
  121.    FldData.CHRISTIAN = "Robert"
  122.    FldData.SURNAME = "Hawke"
  123.    RSET FldData.AGE = "55"         'dBASE III Right justifies numbers
  124.    RSET FldData.DOLLARS = "23.45"
  125.    PUT #1, , FldData
  126.    header.NumRecs = header.NumRecs + 1    'Increment for each Record
  127. 'LOOP until all records are processed
  128. '
  129. '------------------------------------------------
  130. '--- End of File marker appended to the end ---
  131. EOFMarker$ = CHR$(&H1A)
  132. PUT #1, , EOFMarker$
  133. '
  134. '--- Go back to header and write number of Records written to file ---
  135. '    and finish up the program.
  136.  
  137. PUT #1, 5, header.NumRecs
  138. CLOSE #1
  139. PRINT
  140. PRINT "Complete."
  141. END
  142. '
  143. '--- Data Statements specify dBASE III file data structure ---
  144. '    Edit to Suit.
  145. '
  146. DATA 4   : 'tfields   Total number of Fields in a Record
  147. '
  148. flddes:    'Field Name, Data Type, Length, Decimal
  149. DATA CHRISTIAN,C,15,0    : 'Field 1
  150. DATA SURNAME,C,15,0      : 'Field 2
  151. DATA AGE,N,3,0           : 'Field 3
  152. DATA DOLLARS,N,6,2       : 'Field 4
  153.  
  154.